home *** CD-ROM | disk | FTP | other *** search
/ Cinema Studio: Frank Herrmann / Cinema Studio - Frank Herrmann.iso / tools / pbm / rexx / pnmindex < prev    next >
Encoding:
Text File  |  1994-06-28  |  9.1 KB  |  309 lines

  1. /*  pnmindex - build a visual index of a bunch of anymaps
  2.  *
  3.  *  Copyright (C) 1994 by Ingo Wilken (Ingo.Wilken@informatik.uni-oldenburg.de)
  4.  *  Based on the pnmindex csh-script by Jef Poskanzer
  5.  *
  6.  *  Permission to use, copy, modify, and distribute this software and its
  7.  *  documentation for any purpose and without fee is hereby granted, provided
  8.  *  that the above copyright notice appear in all copies and that both that
  9.  *  copyright notice and this permission notice appear in supporting
  10.  *  documentation.  This software is provided "as is" without express or
  11.  *  implied warranty.
  12.  *
  13.  *  $VER: pnmindex 1.0
  14.  */
  15. parse source junk junk progname junk
  16.  
  17. address command
  18. signal on error
  19. signal on break_c
  20. signal on break_d
  21. signal on ioerr
  22. signal on halt
  23. ID = pragma('Id')
  24.  
  25. call open(err, "CONSOLE:", 'W')
  26. if ~result then exit 20
  27.  
  28. if ~show('L', 'rexxsupport.library') then do
  29.     if ~addlib('rexxsupport.library', 0, -30, 0) then exit 20
  30.     end
  31. if ~showlist('A', 'PBMTMP') then 'assign PBMTMP: T:'
  32.  
  33. size = 100          /* make the images about this big */
  34. across = 6          /* show this many images per row */
  35. colors = 256        /* quantize results to this many colors */
  36. back = '-white'     /* default background color */
  37. fastquant = 0       /* -qfast: use ppmqvga instead of ppmquant */
  38. quantall = 1        /* -qonce: quantize only final result instead of every picture */
  39. addsizes = 0        /* -printsizes: add size info below name */
  40. font = ''           /* -font option and fontfile */
  41. baseopt = 0         /* -nopath: print basenames of pictures instead of whole path */
  42. filter = ''         /* run the files through this filter first */
  43.  
  44. if arg() = 0 then call usage
  45.  
  46. parse arg tail
  47. do forever
  48.     parse var tail first tail
  49.     select
  50.         when abbrev('-size',   first, 2) then do
  51.             parse var tail size tail
  52.             if ~datatype(size, 'W') then call usage
  53.             if size < 1 then call usage
  54.             end
  55.         when abbrev('-across', first, 2) then do
  56.             parse var tail across tail
  57.             if ~datatype(across, 'W') then call usage
  58.             if across < 1 then call usage
  59.             end
  60.         when abbrev('-colors', first, 2) then do
  61.             parse var tail colors tail
  62.             if ~datatype(colors, 'W') then call usage
  63.             if colors < 2 then call usage
  64.             end
  65.         when abbrev('-black',  first, 2) then do
  66.             back = '-black'
  67.             end
  68.         when abbrev('-qfast', first, 3) then do
  69.             fastquant = 1
  70.             colors = 256
  71.             end
  72.         when abbrev('-qonce',   first, 3) then do
  73.             quantall = 0
  74.             end
  75.         when abbrev('-printsizes', first, 2) then do
  76.             addsizes = 1
  77.             end
  78.         when abbrev('-nopath', first, 2) then do
  79.             baseopt = 1
  80.             end
  81.         when abbrev('-filter', first, 3) then do
  82.             parse var tail filter tail
  83.             end
  84.         when abbrev('-font', first, 3) then do
  85.             parse var tail first tail
  86.             if ~exists(first) then do
  87.                 call writeln(err, 'fontfile' first 'does not exist')
  88.                 call finish 20
  89.                 end
  90.             font = '-font' first
  91.             end
  92.         when abbrev(first, '-', 1) then call usage
  93.         otherwise leave
  94.     end
  95. end
  96.  
  97. tmpfile = 'PBMTMP:pi.tmp.'ID
  98. tmpfile2= 'PBMTMP:pi.tmp2.'ID
  99. tmppip1 = 'PBMTMP:pi.pip1.'ID
  100. tmppip2 = 'PBMTMP:pi.pip2.'ID
  101. tmppip3 = 'PBMTMP:pi.pip3.'ID
  102. call rm tmpfile tmpfile2 tmppip1 tmppip2 tmppip3
  103. rowfiles = ''
  104. imagefiles = ''
  105. maxformat = 'PBM'
  106. col = 1
  107. row = 1
  108.  
  109. /* Expand filenames */
  110. files = ''
  111. do while first ~= ''
  112.     'list lformat "%s%s"' first 'to' tmppip1
  113.     'echo "" >>' tmppip1   /* avoid 0-byte file, sort would fail */
  114.     'sort from' tmppip1 'to' tmppip2
  115.     call open(file, tmppip2, 'R')
  116.     if ~result then do
  117.         call writeln(err, 'where is my list file??')
  118.         call finish 20
  119.         end
  120.     do while ~eof(file)
  121.         line = readln(file)
  122.         files = files line
  123.         end
  124.     call close(file)
  125.     parse var tail first tail
  126. end
  127. /*call writeln(err, tail)*/
  128. call rm tmppip1 tmppip2
  129.  
  130. parse var files first tail
  131. do while first ~= ''
  132.     /*call writeln err, first*/
  133.     /*tmpfile2 = 'PBMTMP:'basename(first)*/
  134.     if filter ~= '' then do
  135.         filter first '>' tmpfile2
  136.         end
  137.     else do
  138.         'copy' first tmpfile2
  139.         end
  140.     'pnmfile' tmpfile2 '>' tmpfile
  141.     call open(file, tmpfile, 'R')
  142.     if ~result then do
  143.         call writeln(err, 'pnmfile failed?? - aborting')
  144.         call finish 20
  145.         end
  146.     line = readln(file)
  147.     call close(file)
  148.     /* the output format of pnmfile is "name:\tP?M <x> by <y> [...]" */
  149.     parse var line type junk xsize junk ysize junk
  150.     type = right(type,3)
  151.     /*call writeln(err, type xsize ysize)*/
  152.     if xsize <= size & ysize <= size then do
  153.         'copy' tmpfile2 tmpfile
  154.         end
  155.     else do
  156.         select
  157.             when type = 'PBM' then do
  158.                 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmppip1
  159.                 'pgmtopbm' tmppip1 '>' tmpfile
  160.                 end
  161.             when type = 'PGM' then do
  162.                 if maxformat = 'PBM' then maxformat = 'PGM'
  163.                 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmpfile
  164.                 end
  165.             otherwise do
  166.                 maxformat = 'PPM'
  167.                 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmppip1
  168.                 /* 'ppmquant -quiet 'colors tmppip1 '>' tmpfile */
  169.                 if quantall then call quant tmppip1 tmpfile
  170.                 else 'copy' tmppip1 tmpfile
  171.                 end
  172.             end /* select */
  173.         end /* else */
  174.     call rm tmpfile2
  175.     imagefile = 'PBMTMP:pi.'row'.'col'.'ID
  176.     call rm imagefile
  177.     call open(file, tmppip2, 'W')
  178.     if ~result then do
  179.         call writeln(err, 'cannot open tmp file for picture text')
  180.         call finish 20
  181.         end
  182.     if baseopt then
  183.         text = basename(first)
  184.     else
  185.         text = first
  186.     call writeln(file, text)
  187.     if addsizes then call writeln(file,center(compress(xsize 'x' ysize),length(text)))
  188.     call close(file)
  189.     'pbmtext' font '<' tmppip2 '>' tmppip1
  190.     if back = '-white' then do
  191.         'pnmcat' back '-tb' tmpfile tmppip1 '>' imagefile
  192.         end
  193.     else do
  194.         'pnminvert' tmppip1 '>' tmppip2
  195.         'pnmcat' back '-tb' tmpfile tmppip2 '>' imagefile
  196.         end
  197.     call rm tmpfile tmppip1 tmppip2 tmppip3
  198.     imagefiles = imagefiles imagefile
  199.     if col >= across then do
  200.         rowfile = 'PBMTMP:pi.'row'.'ID
  201.         call rm rowfile
  202.         if maxformat ~= 'PPM' then do
  203.             'pnmcat' back '-lr -jbottom' imagefiles '>' rowfile
  204.             end
  205.         else do
  206.             'pnmcat' back '-lr -jbottom' imagefiles '>' tmppip1
  207.             /* 'ppmquant -quiet' colors tmppip1 '>' rowfile */
  208.             if quantall then call quant tmppip1 rowfile
  209.             else 'copy' tmppip1 rowfile
  210.             call rm tmppip1
  211.             end
  212.         call rm imagefiles
  213.         imagefiles = ''
  214.         rowfiles = rowfiles rowfile
  215.         col = 1
  216.         row = row + 1
  217.         end
  218.     else do
  219.         col = col + 1
  220.         end
  221.     parse var tail first tail
  222. end
  223. if words(imagefiles) > 0 then do
  224.     /*call writeln err, imagefiles*/
  225.     rowfile = 'PBMTMP:pi.'row'.'ID
  226.     call rm rowfile
  227.     if maxformat ~= 'PPM' then do
  228.         'pnmcat' back '-lr -jbottom' imagefiles '>' rowfile
  229.         end
  230.     else do
  231.         'pnmcat' back '-lr -jbottom' imagefiles '>' tmppip1
  232.         /* 'ppmquant -quiet' colors tmppip1 '>' rowfile */
  233.         if quantall then call quant tmppip1 rowfile
  234.         else 'copy' tmppip1 rowfile
  235.         call rm tmppip1
  236.         end
  237.     call rm imagefiles
  238.     rowfiles = rowfiles rowfile
  239. end
  240. if rowfiles = '' then do
  241.     call writeln(err, "no input files??")
  242.     call usage
  243.     end
  244. /*call writeln err, rowfiles*/
  245. if maxformat ~= 'PPM' then do
  246.     'pnmcat' back '-tb' rowfiles
  247.     end
  248. else do
  249.     'pnmcat' back '-tb' rowfiles '>' tmppip1
  250.     /* 'ppmquant -quiet' colors tmppip1 */
  251.     call quant tmppip1
  252.     call rm tmppip1
  253.     end
  254. call finish 0
  255.  
  256. usage:
  257.     call writeln err, 'usage:' progname '[-size N] [-across N] [-colors N] [-black] [-filter xxxtop?m] [-printsizes] [-font fontfile] [-nopath] [-qfast] [-qonce] pnmfile ...'
  258.     call finish 10
  259.  
  260. rm: procedure
  261.     arg name
  262.     signal off error    /* ignore WARN */
  263.     'delete' name 'quiet force >NIL:'
  264.     signal on error
  265.     return
  266.  
  267. error:
  268. break_c:
  269. break_d:
  270. ioerr:
  271. halt:
  272.     call writeln err, progname ': break/error at line' SIGL 'code' RC
  273.     call finish 20
  274.  
  275. finish:
  276.     arg n
  277.     call rm 'PBMTMP:pi.#?.'ID
  278.     exit n
  279.  
  280. quant: procedure expose colors fastquant
  281.     arg infile outfile
  282.     if outfile ~= '' then do
  283.         if fastquant then do
  284.             'ppmqvga -quiet' infile '>' outfile
  285.             end
  286.         else do
  287.             'ppmquant -quiet' colors infile '>' outfile
  288.             end
  289.         end
  290.     else do
  291.         if fastquant then do
  292.             'ppmqvga -quiet' infile
  293.             end
  294.         else do
  295.             'ppmquant -quiet' colors infile
  296.             end
  297.         end
  298.     return
  299.  
  300. basename: procedure
  301.     parse arg name
  302.     len = length(name)
  303.     sl = lastpos('/', name)
  304.     if sl > 0 then return right(name, len - sl)
  305.     sl = lastpos(':', name)
  306.     if sl > 0 then return right(name, len - sl)
  307.     return name
  308.  
  309.